Introduction

This rmd. file imports oxygen and voltage data from Google sheet Data is used to plot a oxygen and voltage gradient map of the winogradsky column Exponential and linear models were used to analyze data

Loading Packages

library(tidyverse) 
── Attaching core tidyverse packages ────────────────────────────────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     ── Conflicts ──────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the ]8;;http://conflicted.r-lib.org/conflicted package]8;; to force all conflicts to become errors
library(googledrive) 
library(googlesheets4)

Attaching package: ‘googlesheets4’

The following objects are masked from ‘package:googledrive’:

    request_generate, request_make
#library(ggplot2)
library(knitr)
library(minpack.lm)
library(broom)
library(purrr)
library(lme4)
Loading required package: Matrix

Attaching package: ‘Matrix’

The following objects are masked from ‘package:tidyr’:

    expand, pack, unpack

Importing from google sheet


googlesheets4::gs4_deauth()

CleanData_Oxygen <- googlesheets4::read_sheet("https://docs.google.com/spreadsheets/d/1hNakCyqPsTNRFpf1lGjoBQ-papyZ6xHKT6mcvh3LMb8/edit?pli=1&gid=842906991#gid=842906991", "CleanData_Oxygen") |>
  mutate(Sample = as.character(Sample))
✖ Request failed [429]. Retry 1 happens in 5.1 seconds ...
✔ Reading from Microcosms.
✔ Range ''CleanData_Oxygen''.
kable(CleanData_Oxygen) 
Registered S3 methods overwritten by 'htmltools':
  method               from         
  print.html           tools:rstudio
  print.shiny.tag      tools:rstudio
  print.shiny.tag.list tools:rstudio
Registered S3 method overwritten by 'rmarkdown':
  method         from
  print.paged_df     
Sample Depth_cm DO_µg_L temp_C
1004 0.0 276.0 21.2
1004 6.2 276.0 21.2
1004 8.4 275.0 21.2
1004 13.1 6.3 21.2
1004 22.0 3.4 21.2
1003 0.0 101.0 20.0
1003 5.8 62.0 20.0
1003 8.4 52.0 20.0
1003 13.1 29.0 20.0
1003 21.3 21.0 20.0
1002 0.0 80.0 19.8
1002 6.6 45.0 19.8
1002 9.3 26.0 19.8
1002 15.1 21.0 19.8
1002 21.9 19.0 19.8
1001_C 0.0 190.0 19.0
1001_C 6.9 106.0 19.0
1001_C 10.8 99.0 19.0
1001_C 16.6 57.0 19.0
1001_C 22.7 25.0 19.0
1001_W 0.0 103.0 19.0
1001_W 6.7 34.0 19.0
1001_W 10.2 21.0 19.0
1001_W 15.2 11.0 19.0
1001_W 22.8 8.0 19.0

googlesheets4::gs4_deauth()

CleanData_Voltage <- googlesheets4::read_sheet("https://docs.google.com/spreadsheets/d/1hNakCyqPsTNRFpf1lGjoBQ-papyZ6xHKT6mcvh3LMb8/edit?pli=1&gid=842906991#gid=842906991", "CleanData_Voltage") |>
  mutate(Sample = as.character(Sample))
✔ Reading from Microcosms.
✔ Range ''CleanData_Voltage''.
kable(CleanData_Voltage)
Sample Depth_cm Voltage_Water_10s Voltage_Water_Max Voltage_Tap_10s Voltage_Tap_Max
1004 0.0 NA NA 121.0 121.0
1004 6.2 160.2 190 -168.0 -168.0
1004 8.4 74.4 79 84.0 122.0
1004 13.1 -55.0 58 43.0 51.0
1004 22.0 -200.0 204 84.0 102.0
1003 0.0 NA NA 74.0 300.0
1003 5.8 27.0 27 -13.0 26.0
1003 8.4 59.0 83 57.0 57.0
1003 13.1 -20.0 101 -94.0 -136.0
1003 21.3 -25.0 -30 161.0 177.0
1002 0.0 NA NA 51.0 199.0
1002 6.6 -39.0 -40 13.0 30.0
1002 9.3 -4.3 30 196.0 199.0
1002 15.1 24.0 -4 16.0 25.0
1002 21.9 27.0 28 194.0 199.0
1001_C 0.0 NA NA 187.0 187.0
1001_C 6.9 -10.0 -22 76.0 300.0
1001_C 10.8 25.0 60 -2.8 -2.8
1001_C 16.6 -6.0 -23 -10.5 -3.0
1001_C 22.7 6.0 48 168.0 174.0
1001_W 0.0 NA NA 187.0 187.0
1001_W 6.7 16.0 -9 13.0 170.0
1001_W 10.2 31.0 33 -48.0 -48.0
1001_W 15.2 34.0 40 24.0 24.0
1001_W 22.8 40.0 -17 72.0 72.0

Combine O2 & Voltage data by sample & depth

Gradients <- left_join(x = CleanData_Oxygen, y = CleanData_Voltage, by = c("Sample", "Depth_cm"))

Oxygen Gradient Plot and Modelling

ggplot(data = CleanData_Oxygen) +
geom_point(aes(y = DO_µg_L, x = Depth_cm)) + 
  #scale_y_reverse() +
  #labs( title= "Oxygen Gradients", caption= "Figure X. Dissolved Oxygen (DO) (µg/L) measured in four Winogradsky colums at 5 depths (cm)") 
  #+ theme(plot.caption= element_text(size = 11, hjust=0)) +
  #geom_path(aes(y = Depth_cm, x = DO_µg_L)) +
  facet_grid(cols = vars(Sample)) +
  theme_bw()

#define exponential decay function for data fitting.
exp_decay <- function(x, i, mu){y = i * exp(mu * x)}


O2_nest <- CleanData_Oxygen |>  #alternate forward pipe is %>% loaded with tidyverse
  nest(.by = "Sample") |>
  mutate(DecayFit = purrr::map(data, ~nlsLM(DO_µg_L ~ exp_decay(x = Depth_cm, i, mu),
                                            data = .x)),
         DecayTidy = purrr::map(DecayFit, tidy),
         DecayParam = purrr::map(DecayFit, glance),
         DecayPredict = purrr::map(DecayFit, augment)
         )
Warning: There were 5 warnings in `mutate()`.
The first warning was:
ℹ In argument: `DecayFit = purrr::map(...)`.
Caused by warning in `nlsLM()`:
! No starting values specified for some parameters.
Initializing ‘i’, ‘mu’ to '1.'.
Consider specifying 'start' or using a selfStart model
ℹ Run ]8;;ide:run:dplyr::last_dplyr_warnings()dplyr::last_dplyr_warnings()]8;; to see the 4 remaining warnings.
 

O2_nest |>
unnest(cols = c(DecayTidy)) |>
 select(-c(data, DecayFit, DecayParam, DecayPredict)) |>
  select(-c(statistic)) |>
  pivot_wider(id_cols = Sample, names_from = term, values_from = c(estimate, std.error, p.value)) |>
  kable()
Sample estimate_i estimate_mu std.error_i std.error_mu p.value_i p.value_mu
1004 326.62310 -0.0779518 101.553081 0.0494649 0.0487222 0.2131346
1003 100.85694 -0.0833277 3.557277 0.0059295 0.0000963 0.0007804
1002 78.61257 -0.0897172 6.441339 0.0139884 0.0011845 0.0076805
1001_C 190.11905 -0.0743515 10.391455 0.0078457 0.0003563 0.0024909
1001_W 102.49196 -0.1553412 3.251191 0.0097456 0.0000701 0.0005369

Voltage Gradient Plot and Linear Model


ggplot(data = Gradients) +
  geom_point(aes(x = Depth_cm, y = Voltage_Water_10s)) + 
  facet_grid(cols = vars(Sample)) + 
  theme_bw()


  Linear_fit <- Gradients %>% 
  group_by(Sample) %>%
  group_modify(~ {

  linear <- lm(Voltage_Water_10s ~ Depth_cm, data = .x, na.action = na.exclude)
  augment(linear, data = .x)}) %>%
  ungroup()


  Linear_fit |>   
    ggplot(aes(x = Depth_cm, y = Voltage_Water_10s)) +
    geom_point() +
    geom_line(aes(y = .fitted)) +
    #Showing residuals 
    geom_segment(aes(xend = Depth_cm, yend = .fitted), color = "red") +
    facet_grid(cols = vars((Sample))) +
    theme_bw()

NA
NA
 
Linear_fit_param <- Linear_fit |>
  group_by(Sample) |>
  group_modify(~ {
    linear_model <- lm(Voltage_Water_10s ~ Depth_cm, data = .x)
    tidy_model <- tidy(linear_model)  
    tidy_model$Sample <- unique(.x$Sample)  # Ensure Sample column is added
    return(tidy_model)  
  }) |>
  ungroup() 
Warning: Unknown or uninitialised column: `Sample`.Warning: Unknown or uninitialised column: `Sample`.Warning: Unknown or uninitialised column: `Sample`.Warning: Unknown or uninitialised column: `Sample`.Warning: Unknown or uninitialised column: `Sample`.
Linear_fit_param <- Linear_fit_param |>
  mutate(term = str_replace(term, "\\(Intercept\\)", "I"))

Linear_fit_param |>
  select(-c(statistic)) |>
  pivot_wider(id_cols = Sample, names_from = term, values_from = c(estimate, std.error, p.value)) |>
  kable()
Sample estimate_I estimate_Depth_cm std.error_I std.error_Depth_cm p.value_I p.value_Depth_cm
1001_C 1.370844 0.1669583 24.814453 1.6058696 0.9609665 0.9266817
1001_W 12.287870 1.3087162 6.912976 0.4609137 0.2174605 0.1048823
1002 -51.186449 4.0159886 21.382850 1.4776076 0.1390247 0.1129043
1003 66.227753 -4.6072225 34.968252 2.5893530 0.1987344 0.2171558
1004 269.340131 -22.0877369 39.168813 2.8330251 0.0205004 0.0160561
NA

Can only import one image at a time right now, we could choose some notable ones to display?

LS0tCnRpdGxlOiAiT3h5Z2VuICYgVm9sdGFnZSBHcmFkaWVudHMiCm91dHB1dDogaHRtbF9ub3RlYm9vawotLS0KCiMgSW50cm9kdWN0aW9uCgpUaGlzIHJtZC4gZmlsZSBpbXBvcnRzIG94eWdlbiBhbmQgdm9sdGFnZSBkYXRhIGZyb20gR29vZ2xlIHNoZWV0CkRhdGEgaXMgdXNlZCB0byBwbG90IGEgb3h5Z2VuIGFuZCB2b2x0YWdlIGdyYWRpZW50IG1hcCBvZiB0aGUgd2lub2dyYWRza3kgY29sdW1uIApFeHBvbmVudGlhbCBhbmQgbGluZWFyIG1vZGVscyB3ZXJlIHVzZWQgdG8gYW5hbHl6ZSBkYXRhCgojIExvYWRpbmcgUGFja2FnZXMgCgpgYGB7ciBsb2FkaW5nIHBhY2thZ2VzfQpsaWJyYXJ5KHRpZHl2ZXJzZSkgCmxpYnJhcnkoZ29vZ2xlZHJpdmUpIApsaWJyYXJ5KGdvb2dsZXNoZWV0czQpCiNsaWJyYXJ5KGdncGxvdDIpCmxpYnJhcnkoa25pdHIpCmxpYnJhcnkobWlucGFjay5sbSkKbGlicmFyeShicm9vbSkKbGlicmFyeShwdXJycikKbGlicmFyeShsbWU0KQpgYGAKCiMgSW1wb3J0aW5nIGZyb20gZ29vZ2xlIHNoZWV0CgpgYGB7ciBsb2FkIENsZWFuT3h5Z2VuRGF0YSBkaXJlY3QgZnJvbSBnb29nbGVzaGVldH0KCmdvb2dsZXNoZWV0czQ6OmdzNF9kZWF1dGgoKQoKQ2xlYW5EYXRhX094eWdlbiA8LSBnb29nbGVzaGVldHM0OjpyZWFkX3NoZWV0KCJodHRwczovL2RvY3MuZ29vZ2xlLmNvbS9zcHJlYWRzaGVldHMvZC8xaE5ha0N5cVBzVE5SRnBmMWxHam9CUS1wYXB5WjZ4SEtUNm1jdmgzTE1iOC9lZGl0P3BsaT0xJmdpZD04NDI5MDY5OTEjZ2lkPTg0MjkwNjk5MSIsICJDbGVhbkRhdGFfT3h5Z2VuIikgfD4KICBtdXRhdGUoU2FtcGxlID0gYXMuY2hhcmFjdGVyKFNhbXBsZSkpCgprYWJsZShDbGVhbkRhdGFfT3h5Z2VuKSAKYGBgCgpgYGB7ciBsb2FkIENsZWFuVm9sdGFnZURhdGEgZGlyZWN0IGZyb20gZ29vZ2xlc2hlZXR9Cgpnb29nbGVzaGVldHM0OjpnczRfZGVhdXRoKCkKCkNsZWFuRGF0YV9Wb2x0YWdlIDwtIGdvb2dsZXNoZWV0czQ6OnJlYWRfc2hlZXQoImh0dHBzOi8vZG9jcy5nb29nbGUuY29tL3NwcmVhZHNoZWV0cy9kLzFoTmFrQ3lxUHNUTlJGcGYxbEdqb0JRLXBhcHlaNnhIS1Q2bWN2aDNMTWI4L2VkaXQ/cGxpPTEmZ2lkPTg0MjkwNjk5MSNnaWQ9ODQyOTA2OTkxIiwgIkNsZWFuRGF0YV9Wb2x0YWdlIikgfD4KICBtdXRhdGUoU2FtcGxlID0gYXMuY2hhcmFjdGVyKFNhbXBsZSkpCgprYWJsZShDbGVhbkRhdGFfVm9sdGFnZSkKYGBgCgpDb21iaW5lIE8yICYgVm9sdGFnZSBkYXRhIGJ5IHNhbXBsZSAmIGRlcHRoCmBgYHtyIGdyYWRpZW50c19kZn0KR3JhZGllbnRzIDwtIGxlZnRfam9pbih4ID0gQ2xlYW5EYXRhX094eWdlbiwgeSA9IENsZWFuRGF0YV9Wb2x0YWdlLCBieSA9IGMoIlNhbXBsZSIsICJEZXB0aF9jbSIpKQpgYGAKCgojIE94eWdlbiBHcmFkaWVudCBQbG90IGFuZCBNb2RlbGxpbmcKCmBgYHtyIE94eWdlbiBncmFkaWVudHN9CmdncGxvdChkYXRhID0gQ2xlYW5EYXRhX094eWdlbikgKwpnZW9tX3BvaW50KGFlcyh5ID0gRE9fwrVnX0wsIHggPSBEZXB0aF9jbSkpICsgCiAgI3NjYWxlX3lfcmV2ZXJzZSgpICsKICAjbGFicyggdGl0bGU9ICJPeHlnZW4gR3JhZGllbnRzIiwgY2FwdGlvbj0gIkZpZ3VyZSBYLiBEaXNzb2x2ZWQgT3h5Z2VuIChETykgKMK1Zy9MKSBtZWFzdXJlZCBpbiBmb3VyIFdpbm9ncmFkc2t5IGNvbHVtcyBhdCA1IGRlcHRocyAoY20pIikgCiAgIysgdGhlbWUocGxvdC5jYXB0aW9uPSBlbGVtZW50X3RleHQoc2l6ZSA9IDExLCBoanVzdD0wKSkgKwogICNnZW9tX3BhdGgoYWVzKHkgPSBEZXB0aF9jbSwgeCA9IERPX8K1Z19MKSkgKwogIGZhY2V0X2dyaWQoY29scyA9IHZhcnMoU2FtcGxlKSkgKwogIHRoZW1lX2J3KCkKCmBgYAoKYGBge3IgZGVjYXkgZml0c30KI2RlZmluZSBleHBvbmVudGlhbCBkZWNheSBmdW5jdGlvbiBmb3IgZGF0YSBmaXR0aW5nLgpleHBfZGVjYXkgPC0gZnVuY3Rpb24oeCwgaSwgbXUpe3kgPSBpICogZXhwKG11ICogeCl9CgoKTzJfbmVzdCA8LSBDbGVhbkRhdGFfT3h5Z2VuIHw+ICAjYWx0ZXJuYXRlIGZvcndhcmQgcGlwZSBpcyAlPiUgbG9hZGVkIHdpdGggdGlkeXZlcnNlCiAgbmVzdCguYnkgPSAiU2FtcGxlIikgfD4KICBtdXRhdGUoRGVjYXlGaXQgPSBwdXJycjo6bWFwKGRhdGEsIH5ubHNMTShET1/CtWdfTCB+IGV4cF9kZWNheSh4ID0gRGVwdGhfY20sIGksIG11KSwKICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBkYXRhID0gLngpKSwKICAgICAgICAgRGVjYXlUaWR5ID0gcHVycnI6Om1hcChEZWNheUZpdCwgdGlkeSksCiAgICAgICAgIERlY2F5UGFyYW0gPSBwdXJycjo6bWFwKERlY2F5Rml0LCBnbGFuY2UpLAogICAgICAgICBEZWNheVByZWRpY3QgPSBwdXJycjo6bWFwKERlY2F5Rml0LCBhdWdtZW50KQogICAgICAgICApCgogCmBgYApgYGB7ciBwbG90IE8yIGRlY2F5IGZpdHN9Ck8yX25lc3QgfD4KICB1bm5lc3QoY29scyA9IGMoRGVjYXlQcmVkaWN0KSkgfD4KICBnZ3Bsb3QoKSArCiAgZ2VvbV9wb2ludChhZXMoeCA9IERlcHRoX2NtLCB5ID0gRE9fwrVnX0wpKSArCiAgZ2VvbV9saW5lKGFlcyh4ID0gRGVwdGhfY20sIHkgPSAuZml0dGVkKSkgKwogIGdlb21fcG9pbnQoYWVzKHggPSBEZXB0aF9jbSwgeSA9IC5yZXNpZCksIGNvbG91ciA9ICJyZWQiKSArCiAgZmFjZXRfZ3JpZChjb2xzID0gdmFycygoU2FtcGxlKSkpICsKICAgIHRoZW1lX2J3KCkKYGBgCgpgYGB7ciBzaG93IGZpdCBwYXJhbWV0ZXJzfQpPMl9uZXN0IHw+CnVubmVzdChjb2xzID0gYyhEZWNheVRpZHkpKSB8Pgogc2VsZWN0KC1jKGRhdGEsIERlY2F5Rml0LCBEZWNheVBhcmFtLCBEZWNheVByZWRpY3QpKSB8PgogIHNlbGVjdCgtYyhzdGF0aXN0aWMpKSB8PgogIHBpdm90X3dpZGVyKGlkX2NvbHMgPSBTYW1wbGUsIG5hbWVzX2Zyb20gPSB0ZXJtLCB2YWx1ZXNfZnJvbSA9IGMoZXN0aW1hdGUsIHN0ZC5lcnJvciwgcC52YWx1ZSkpIHw+CiAga2FibGUoKQpgYGAKCiMgVm9sdGFnZSBHcmFkaWVudCBQbG90IGFuZCBMaW5lYXIgTW9kZWwKCmBgYHtyIFBsb3R0aW5nIFZvbHRhZ2UgR3JhZGllbnRzIGluIHdhdGVyIGF0IDEwIHNlY29uZHN9CgpnZ3Bsb3QoZGF0YSA9IEdyYWRpZW50cykgKwogIGdlb21fcG9pbnQoYWVzKHggPSBEZXB0aF9jbSwgeSA9IFZvbHRhZ2VfV2F0ZXJfMTBzKSkgKyAKICBmYWNldF9ncmlkKGNvbHMgPSB2YXJzKFNhbXBsZSkpICsgCiAgdGhlbWVfYncoKQpgYGAKCgpgYGB7ciBQbG90dGluZyBXaXRoIGEgbGluZWFyIGZpdH0KCiAgTGluZWFyX2ZpdCA8LSBHcmFkaWVudHMgJT4lIAogIGdyb3VwX2J5KFNhbXBsZSkgJT4lCiAgZ3JvdXBfbW9kaWZ5KH4gewoKICBsaW5lYXIgPC0gbG0oVm9sdGFnZV9XYXRlcl8xMHMgfiBEZXB0aF9jbSwgZGF0YSA9IC54LCBuYS5hY3Rpb24gPSBuYS5leGNsdWRlKQogIGF1Z21lbnQobGluZWFyLCBkYXRhID0gLngpfSkgJT4lCiAgdW5ncm91cCgpCgoKICBMaW5lYXJfZml0IHw+ICAgCiAgICBnZ3Bsb3QoYWVzKHggPSBEZXB0aF9jbSwgeSA9IFZvbHRhZ2VfV2F0ZXJfMTBzKSkgKwogICAgZ2VvbV9wb2ludCgpICsKICAgIGdlb21fbGluZShhZXMoeSA9IC5maXR0ZWQpKSArCiAgICAjU2hvd2luZyByZXNpZHVhbHMgCiAgICBnZW9tX3NlZ21lbnQoYWVzKHhlbmQgPSBEZXB0aF9jbSwgeWVuZCA9IC5maXR0ZWQpLCBjb2xvciA9ICJyZWQiKSArCiAgICBmYWNldF9ncmlkKGNvbHMgPSB2YXJzKChTYW1wbGUpKSkgKwogICAgdGhlbWVfYncoKQoKCmBgYAoKCmBgYHtyIEV4YW1pbmluZyBsaW5lYXIgZml0IHBhcmFtZXRlcnN9CiAKTGluZWFyX2ZpdF9wYXJhbSA8LSBMaW5lYXJfZml0IHw+CiAgZ3JvdXBfYnkoU2FtcGxlKSB8PgogIGdyb3VwX21vZGlmeSh+IHsKICAgIGxpbmVhcl9tb2RlbCA8LSBsbShWb2x0YWdlX1dhdGVyXzEwcyB+IERlcHRoX2NtLCBkYXRhID0gLngpCiAgICB0aWR5X21vZGVsIDwtIHRpZHkobGluZWFyX21vZGVsKSAgCiAgICB0aWR5X21vZGVsJFNhbXBsZSA8LSB1bmlxdWUoLngkU2FtcGxlKSAgIyBFbnN1cmUgU2FtcGxlIGNvbHVtbiBpcyBhZGRlZAogICAgcmV0dXJuKHRpZHlfbW9kZWwpICAKICB9KSB8PgogIHVuZ3JvdXAoKSAKCkxpbmVhcl9maXRfcGFyYW0gPC0gTGluZWFyX2ZpdF9wYXJhbSB8PgogIG11dGF0ZSh0ZXJtID0gc3RyX3JlcGxhY2UodGVybSwgIlxcKEludGVyY2VwdFxcKSIsICJJIikpCgpMaW5lYXJfZml0X3BhcmFtIHw+CiAgc2VsZWN0KC1jKHN0YXRpc3RpYykpIHw+CiAgcGl2b3Rfd2lkZXIoaWRfY29scyA9IFNhbXBsZSwgbmFtZXNfZnJvbSA9IHRlcm0sIHZhbHVlc19mcm9tID0gYyhlc3RpbWF0ZSwgc3RkLmVycm9yLCBwLnZhbHVlKSkgfD4KICBrYWJsZSgpCiAKYGBgCgojIENhbiBvbmx5IGltcG9ydCBvbmUgaW1hZ2UgYXQgYSB0aW1lIHJpZ2h0IG5vdywgd2UgY291bGQgY2hvb3NlIHNvbWUgbm90YWJsZSBvbmVzIHRvIGRpc3BsYXk/CmBgYHtyIGVjaG89RkFMU0UsIG91dC53aWR0aD0iMTAwJSIsIGZpZy5jYXA9Ik15IEltYWdlIn0Ka25pdHI6OmluY2x1ZGVfZ3JhcGhpY3MoIi4uL2RvY3MvU2xpZGVQaG90b3MvMTAwMV82LjZfQy5qcGciKQpgYGAKCg==